home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / HCOPY.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  2KB  |  66 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit HCopy;
  10.  
  11. interface
  12.  
  13. uses WinTypes;
  14.  
  15. procedure PrintBitMap(HWindow: HWnd; BitMap: HBitMap);
  16.  
  17. implementation
  18.  
  19. uses WinProcs, Strings;
  20.  
  21. procedure PrintBitMap(HWindow: HWnd; BitMap: HBitMap);
  22. var
  23.   DC, ScreenDC, MemDC: HDC;
  24.   BM: TBitMap;
  25.   OldBitMap: HBitMap;
  26.   Driver, PrintDevice, Port: array[0..40] of Char;
  27.   S: array[0..10] of Char;
  28.   DCaps: Word;
  29.  
  30. procedure GetIniInfo(ADriver, ADevice, Port: PChar);
  31. var
  32.   PrinterString: array[0..80] of char;
  33.   Device, Driver, OutPut: PChar;
  34. begin
  35.   GetProfileString('Windows', 'Device', ',,,', PrinterString, 80);
  36.   Device := PrinterString;
  37.   Driver := StrScan(Device, ',');
  38.   Driver[0] := #0;
  39.   Inc(Driver);
  40.   OutPut := StrScan(Driver, ',');
  41.   OutPut[0] := #0;
  42.   Inc(OutPut);
  43.   StrCopy(Port, OutPut);
  44.   StrCopy(ADevice, Device);
  45.   StrCopy(ADriver, Driver);
  46. end;
  47.  
  48. begin
  49.   GetIniInfo(Driver, PrintDevice, Port);
  50.   DC := CreateDC(Driver, PrintDevice, Port, Nil);
  51.   StrCopy(S,'HardCopy'#0);
  52.   Escape(DC, STARTDOC, 8, @S, nil);
  53.   ScreenDC := GetDC(HWindow);
  54.   MemDC := CreateCompatibleDC(ScreenDC);
  55.   OldBitMap := SelectObject(MemDC, BitMap);
  56.   GetObject(BitMap, SizeOf(BM), @BM);
  57.   BitBlt(DC, 0, 0, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCOPY);
  58.   Escape(DC, NEWFRAME, 0, nil, nil);
  59.   Escape(DC, ENDDOC, 0, nil, nil);
  60.   SelectObject(MemDC, OldBitMap);
  61.   ReleaseDC(HWindow, ScreenDC);
  62.   DeleteDC(MemDC);
  63.   DeleteDC(DC);
  64. end;
  65. END.
  66.